home *** CD-ROM | disk | FTP | other *** search
/ Aminet 52 / Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso / Aminet / gfx / conv / wbmp.lha / ILBM2WBMP.rexx next >
OS/2 REXX Batch file  |  2002-09-03  |  3KB  |  120 lines
  1. /* ILBM -> Wireles Bitmap
  2. $VER: Version 1.0 (03.09.02) */
  3. IF ~SHOW('LIBRARIES','rexxsupport.library') THEN DO
  4.    IF ~ADDLIB('rexxsupport.library',10,-30,0) THEN DO
  5.       SAY 'Kann die <rexxsupport.library> nicht öffnen!'
  6.       EXIT(10)
  7.    END
  8. END
  9. Parse Arg OPTS
  10. Parse Value OPTS with ILBM ' ' WBMP
  11. IF Exists(ILBM)=0 Then Do
  12. say "ILBM-file not found!"
  13. Exit(0)
  14. End
  15. If ILBM="" | WBMP="" Then Do
  16. Say '1b5b33326d'x||"ilbm2wbmp"||'1b5b33316d'x||" ilbm-file outfile"
  17. Exit(0)
  18. End
  19. ILBMLaenge=SUBWORD(STATEF(ILBM),2,1)
  20. If ILBMLaenge>65535 Then Do
  21. "Say Picture to large"
  22. Exit(0)
  23. End
  24. Call Open(ILBM,ILBM,R)
  25. ILBM$=Readch(ILBM,ILBMLaenge)
  26. If Substr(ILBM$,9,4)~="ILBM" Then Do
  27. Say "not a ILBM-Picture"
  28. Exit(0)
  29. End
  30. BMHD=Pos("BMHD",ILBM$,1)
  31. ILBMWidth=C2D(Substr(ILBM$,BMHD+8,2))
  32. If ILBMWidth>127 Then Do
  33. say "Width to large"
  34. Exit(0)
  35. End
  36. ILBMHeight=C2D(Substr(ILBM$,BMHD+10,2))
  37. If ILBMHeight>127 Then Do
  38. say "Height to large"
  39. Exit(0)
  40. End
  41. ILBMDepth=C2D(Substr(ILBM$,BMHD+16,1))
  42. If ILBMDepth>1 Then Do
  43. say "to many Bitplanes"||D2C(10)||"only 2 colours (1 Bit Depth)"
  44. Exit(0)
  45. End
  46. Compress=C2D(Substr(ILBM$,BMHD+18,1))
  47. BODYAdr=Pos("BODY",ILBM$,1)+8
  48. WBMPRowlen=ILBMWidth%8
  49. IF ILBMWidth//8~=0 Then WBMPRowlen=WBMPRowlen+1
  50. ILBMRowlen=WBMPRowlen
  51. If (ILBMRowlen*8)//16~=0 Then ILBMRowlen=ILBMRowlen+1
  52. WBMPBODYLen=WBMPRowlen*ILBMHeight
  53. ILBMBODYLen=ILBMRowlen*ILBMHeight
  54. ReadPos=seek(ILBM,BODYAdr-1,Begin)
  55. say "Input-file "|| ILBM ||" [ILBM] "||ILBMWidth||"x"||ILBMHeight||"x1"
  56. say "create wireless bitmap "||WBMP
  57. If Compress=0 Then Do
  58. Call Nocompress()
  59. End
  60. Else Do
  61. Call Byterun()
  62. End
  63.  
  64. C=Close(WBMP)
  65. C=CLOSE(ILBM)
  66. Exit(0)
  67.  
  68. NoCompress:
  69. Call Open(WBMP,WBMP,W)
  70. wr=Writech(WBMP,X2C(D2X(ILBMWidth,6)))
  71. wr=Writech(WBMP,X2C(D2X(ILBMHeight,2)))
  72. C=Close(WBMP)
  73. Call Open(WBMP,WBMP,A)
  74. RowDummy=Insert(D2C(0),"",1,WBMPRowlen-1,D2C(0))
  75. Do D=1 To ILBMHeight
  76. Row=Overlay(Readch(ILBM,WBMPRowlen),RowDummy,1,WBMPRowlen)
  77. Wr=Writech(WBMP,Row)
  78. ReadPos=seek(ILBM,Readpos+ILBMRowLen,Begin)
  79. End
  80. say "done"
  81. Return(0)
  82.  
  83. Byterun:
  84. Say "decode byterun..."
  85. Call Open(WBMP,WBMP,W)
  86. wr=Writech(WBMP,X2C(D2X(ILBMWidth,6)))
  87. wr=Writech(WBMP,X2C(D2X(ILBMHeight,2)))
  88. C=Close(WBMP)
  89. Call Open(WBMP,WBMP,A)
  90. ReadAdr=0 ; WriteAdr=1 ; Dummy=""
  91. Endrow=ILBMHeight*ILBMDepth
  92. Do Durchlauf = 1 To Endrow
  93. RBZ=0 ; Row=""
  94. Do Until(RBZ>=ILBMRowlen)
  95. If RBZ<=ILBMRowlen Then Do
  96. Compw=C2D(Substr(ILBM$,Bodyadr+ReadAdr,1))
  97. If Compw>127 Then Do
  98. WriteLen=257-Compw
  99. Bytes=Insert("",Substr(ILBM$,Bodyadr+ReadAdr+1,1),0,Writelen-1,Substr(ILBM$,Bodyadr+ReadAdr+1,1))
  100. WriteAdr=WriteAdr+WriteLen
  101. RBZ=RBZ+WriteLen
  102. ReadAdr=ReadAdr+2
  103. Row=Row||Bytes
  104. End
  105. Else Do
  106. WriteLen=Compw+1
  107. Bytes=Substr(ILBM$,Bodyadr+ReadAdr+1,WriteLen)
  108. WriteAdr=WriteAdr+WriteLen
  109. RBZ=RBZ+WriteLen
  110. ReadAdr=ReadAdr+WriteLen+1
  111. Row=Row||Bytes
  112. End
  113. End
  114. End
  115. Writerow=Substr(Row,1,WBMPRowLen)
  116. Wr=Writech(WBMP,writeRow)
  117. End
  118. say '0b'x||"done             "
  119. Return(0)
  120.